/*rx
    $VER: $Id: MakeTree.mm,v 1.10 1994/06/20 01:08:07 tf Exp $

    Create all directories listed in a tree file relative to a given directory.
    The directory structure and a comment for each directory will be taken
    from a TREE file.

    This ARexx script needs the AmigaDOS commands "MakeDir", "Filenote" and
    "Delete" available in your path.

    Initial revision by Tobias Ferber, 21-Feb-94
*/

options results
options failat 10

/* default values */

treefile = ""
destpath = ""   /* parent dir of those listed in the treefile */
tempfile = "T:MakeTreeTemp." || pragma('Id')
template = "FROM/K/A,TO/K/A,NOCREATE/S,AUTO/S"
cliopts  = ""

dg       = 0  /* gauge increment */
gstepN   = 0

ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D


/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "FROM" then do
      if ac < arg() then do
        ac= ac+1
        treefile= arg(ac)
        end
      else exit bad_args('Missing Aminet TREE path/filename after' ESC'bFROM'ESC'n keyword.')
      end /* FROM */

    when upper(av) = "TO" then do
      if ac < arg() then do
        ac= ac+1
        destpath= arg(ac)
        if words(destpath) < 1 then destpath= pragma('D')
        end
      else exit bad_args('Missing destination pathname after' ESC'bTO'ESC'n keyword.')
      end /* TO */

    when upper(av) = "AUTO"     then cliopts= cliopts || 'a'
    when upper(av) = "NOCREATE" then cliopts= cliopts || 'n'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

    end /* select */

  end /* do */

call pragma('W','N')


/* try to get missing tree filename */

if words(treefile) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select a TREE file..."' NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then treefile= result
  end

if words(treefile) < 1 then
  exit bad_args("Not enough arguments for MakeTree...*nExiting...")

if ~exists(treefile) then do
  REQUESTCHOICE TITLE   '"MakeTree Request"',
                BODY    '"MakeTree failed to locate your tree file*n*n' ||,
                        ESC'c'ESC'b' || treefile || ESC'n'ESC'l'        || '"',
                GADGETS '"Exit"'
  exit 10
  end

/* get missing destination pathname */

if words(destpath) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select a destination path..."' DRAWERSONLY NOICONS SAVEMODE
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then destpath= result
  end

if words(destpath) < 1 then
  exit bad_args("Not enough arguments for MakeTree...*nExiting...")

if ~exists(destpath) & canexist(destpath) then do
  REQUESTCHOICE TITLE   '"MakeTree Request"',
                BODY    '"Destination path*n*n'                      ||,
                        ESC'c'ESC'b' || destpath || ESC'n'ESC'l*n*n' ||,
                        'does not exist.  Shall I create it?'        || '"',
                GADGETS '"_Yes|_No"'

  if result = '1' then call makepath(destpath)
  end

if ~exists(destpath) then do
  REQUESTCHOICE TITLE   '"MakeTree Request"',
                BODY    '"Failed to locate your destination path*n*n' ||,
                        ESC'c'ESC'b' || destpath || ESC'n'ESC'l'      || '"',
                GADGETS '"Exit"'
  exit 10
  end


CALL init_gauge(treefile,2)


signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


/* open the TREE file */

if ~open('fp',treefile,'R') then do
  REQUESTCHOICE TITLE   '"MakeTree Request"',
                BODY    '"Could not open your tree file*n*n'     ||,
                        ESC'c'ESC'b' || treefile || ESC'n'ESC'l' || '"',
                GADGETS '"Exit"'
  exit 10
  end

do until eof('fp')

  line= strip( readln('fp') )

  if ( words(line) > 0 ) & ( left(line,1) ~= '#' ) & ( left(line,1) ~= ';') then do
    pathname = tackon( destpath, word(line,1) )
    comment  = strip( delword(line,1,1) )

    if ~exists(pathname) & (pos('n',cliopts) < 1) then do
      if canexist(pathname) then do
        call makepath(pathname)
        str= "[created]"
        end
      else do
        REQUESTCHOICE TITLE   '"MakeTree Warning"',
                      BODY    '"Illegal pathname:*n*n'ESC'c'ESC'b' || pathname || ESC'n'ESC'l"',
                      GADGETS '"Ignore"'
        MESSAGE '"Illegal pathname:' pathname '... ignored"'
        str= "[illegal]"
        end
      end
    else str= "[exists]"

    CALL step_gauge(1)

    if exists(pathname) then do
      if words(comment) > 0 then do
        address command 'Filenote FILE' '"'pathname'"' 'COMMENT' transquote(comment)
        end

      MESSAGE transquote( left(pathname,30) || left(comment,40) || str )
      end

    CALL step_gauge(1)

    end /* non-empty line */

  end /* do */

call step_gauge(100)
call close('fp')
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
exit


/**/

bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg

  REQUESTCHOICE TITLE   '"MakeTree Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'MakeTree args template:*n*n'            ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0


/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )

  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end

  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* stretch the blue completion bar */

step_gauge: PROCEDURE EXPOSE dg gstepN
  ARG increment
  gstepN= gstepN + 1
  c= MIN(TRUNC(gstepN * increment * dg),100)
  COMPLETE c
  IF c >= 100 THEN WORKING '"done."'
  RETURN 0


/* initialize the gauge increment by counting the #of steps to be performed */

init_gauge: PROCEDURE EXPOSE dg gstepN
  PARSE ARG fname,steps_per_entry

  dg = 0         /* gauge increment */
  gstepN = 0     /* #of performed steps */

  IF OPEN('fp',fname,'R') THEN DO
    numentries= 0
    DO UNTIL EOF('fp')
      IF WORDS(READLN('fp')) > 0 THEN
        numentries= numentries+1
      END
    WORKING '"Processing' numentries 'entries..."'
    dg = 100 / (numentries * steps_per_entry)
    CALL SEEK('fp',0,'B')
    CALL CLOSE('fp')
    END

  MESSAGE CLEAR; MESSAGE OPEN
  COMPLETE 0
  RETURN 0


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeTree Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeTree Internal Error' err'"',
                BODY    '"MakeTree seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                     || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"MakeTree Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit
